Importação de pacotes necessários e funções personalizadas

Além dos pacotes necessários, as funções são necessárias para calcular o resultado final de cada jogo, a quantidade final de pontos de cada equipe e também montar uma tabela de classificação de acordo com um conjunto de placares.

# Pacotes necessários
library(tidyverse)
library(goalmodel)
library(worldfootballR)
library(regista)
library(janitor)
library(magrittr)
library(ggrepel)
library(ggtext)
library(jsonlite)
library(gt)
library(gtExtras)
library(MetBrewer)

# Funções para calcular o resultado da partida
calcV <- function(hg, ag){
  return(hg > ag)
}
calcD <- function(hg, ag){
  return(hg < ag)
}
calcE <- function(hg, ag){
  return(hg == ag)
}
calcPTS <- function(hg, ag){
  return(ifelse(hg < ag, 0, ifelse(hg == ag, 1, 3)))
}
calcTAB <- function(games){
  home <- games %>%
    mutate(casa_V = calcV(hgoal, agoal),
           casa_E = calcE(hgoal, agoal),
           casa_D = calcD(hgoal, agoal),
           casa_PTS = calcPTS(hgoal,agoal)) %>%
    group_by(home) %>% summarise(casa_PTS = sum(casa_PTS),
                                 casa_J = length(home),
                                 casa_V = sum(casa_V),
                                 casa_E = sum(casa_E),
                                 casa_D = sum(casa_D),
                                 casa_GP = sum(as.numeric(hgoal)),
                                 casa_GS = sum(as.numeric(agoal)),
                                 casa_SG = sum(as.numeric(hgoal)) - sum(as.numeric(agoal))) %>%
    dplyr::rename(Time = home)
  
  away <- games %>%
    mutate(fora_V = calcV(agoal, hgoal),
           fora_E = calcE(agoal, hgoal),
           fora_D = calcD(agoal, hgoal),
           fora_PTS = calcPTS(agoal,hgoal)) %>%
    group_by(away) %>% summarise(fora_PTS = sum(fora_PTS),
                                 fora_J = length(away),
                                 fora_V = sum(fora_V),
                                 fora_E = sum(fora_E),
                                 fora_D = sum(fora_D),
                                 fora_GP = sum(as.numeric(agoal)),
                                 fora_GS = sum(as.numeric(hgoal)),
                                 fora_SG = sum(as.numeric(agoal)) - sum(as.numeric(hgoal))) %>%
    dplyr::rename(Time = away)
  
  total <- inner_join(home, away, by = 'Time') %>%
    mutate(PTS = casa_PTS + fora_PTS,
           J = casa_J + fora_J,
           V = casa_V + fora_V,
           E = casa_E + fora_E,
           D = casa_D + fora_D,
           GP = casa_GP + fora_GP,
           GS = casa_GS + fora_GS,
           SG = casa_SG + fora_SG) %>%
    select(Time, PTS, J, V, E, D, GP, GS, SG) %>%
    arrange(desc(PTS), desc(V), desc(SG), desc(GP)) %>%
    mutate(Pos = row_number()) %>%
    relocate(Pos) %>%
    mutate(AP = round(PTS / (J * 3) * 100, digits = 1))
  
  return(total)
}

current_date <- strftime(Sys.Date(), format = "%d-%m-%Y")
camcorder::gg_record(
  dir = file.path(here::here("camcorder_outputs")),
  device = "png",
  width = 18,
  height = 10,
  dpi = 300)
sysfonts::font_add_google(name = "IBM Plex Sans", family = "IBM")
showtext::showtext_auto()
showtext::showtext_opts(dpi = 300)
font <- "IBM"

Extração e manipulação dos dados necessários para o modelo

Os dados utilizados são originários do site FBRef e para tentar aumentar a eficácia do modelo coletaremos todos os placares dos jogos do Campeonato Brasileiro desde 2014. Os jogos já disputados em 2023, obviamente, serão integrados à parte de treinamento de modelo, que será então aplicado aos jogos ainda por disputar.

Na data da elaboração original desse modelo, no dia 17 de agosto, o Campeonato Brasileiro acabava de chegar ao final do seu primeiro turno, tendo o Botafogo como líder incontestável. Com 47 pontos nas 19 partidas disputadas no primeiro turno, o Botafogo igualava em pontos o desempenho do Corinthians na primeira metade de 2017. O primeiro critério de desempate de acordo com o regulamento do campeonato, o número de vitórias, deu ao Botafogo o melhor primeiro turno da história: foram 15 vitórias contra 14 do Corinthians em 2017, que também fez história ao fechar de maneira invicta a sequência de 19 jogos.

folder <- "C:/R/Simuladores BR 2023/"
# Dataframe vazio para armazenar todas tabelas finais
montecarlo_tabelas <- setNames(data.frame(matrix(ncol = 12, nrow = 0)),
                               c('Pos', 'Time', 'PTS', 'J', 'V', 'E',
                                 'D', 'GP', 'GS', 'SG', 'AP', 'sim'))
# Lista de dataframes
montecarlo_tabelas_df <- list()

# Dataframe vazio para armazenar todos os jogos
montecarlo_jogos <- setNames(data.frame(matrix(ncol = 10, nrow = 0)),
                             c('year', 'home', 'hgoal', 'agoal', 'away',
                               'p1', 'pX', 'p2', 'hxg', 'axg'))
# Lista de dataframes
montecarlo_jogos_df <- list()

# Extraindo dados do Campeonato Brasileiro de 2023 do FBRef
data_2023 <- fb_match_results(country = "BRA",
                              gender = "M",
                              season_end_year = 2023,
                              tier = "1st") %>%
  clean_names() %>% factor_teams(c("home", "away")) %>% 
  rename(hgoal = home_goals, agoal = away_goals) %>% 
  select('date', 'home', 'away', 'hgoal', 'agoal')

# Lista de times
times <- unique(data_2023$home)

# Extraindo dados das outras edições disponíveis no FBRef
# Esses jogos servirão como treinamento do modelo
train_data <- fb_match_results(country = "BRA",
                               gender = "M",
                               season_end_year = c(2014,2015,2016,
                                                   2017,2018,2019,
                                                   2020,2021,2022),
                               tier = "1st") %>%
  clean_names() %>% factor_teams(c("home", "away")) %>% 
  rename(hgoal = home_goals, agoal = away_goals) %>% 
  select('date', 'home', 'away', 'hgoal', 'agoal')

# Separando os jogos já disputados em 2023
# Esses jogos farão parte do treinamento do modelo
played_2023 <- data_2023 %>% filter(!is.na(hgoal) & !is.na(agoal))
train_data <- rbind(train_data, played_2023)

# Separando os jogos ainda não disputados de 2023
# Esses jogos serão o teste do modelo
test_data <- data_2023 %>% filter(is.na(hgoal) & is.na(agoal))

# Criando um dataframe para todos os jogos desde 2014
full_data <- rbind(train_data, test_data)

Criação e visualização do modelo

Nessa visualização do modelo, o sumário mostrará todos os times presentes nos dados fornecidos ao modelo. Isso significa que todos os clubes participantes de ao menos uma edição do Campeonato Brasileiro desde 2014 estarão presentes.

pesos <- weights_dc(train_data$date, xi = 0.003)
model <- goalmodel(goals1 = train_data$hgoal,
                   goals2 = train_data$agoal,
                   team1 = train_data$home,
                   team2 = train_data$away,
                   dc = TRUE,
                   rs = TRUE,
                   model = 'poisson',
                   weights = pesos)
summary(model)
## Model sucsessfully fitted in 17.71 seconds
## 
## Number of matches          3618 
## Number of teams              34 
## 
## Model                     Poisson 
## 
## Log Likelihood            -952.77 
## AIC                        2045.54 
## R-squared                  0.12 
## Parameters (estimated)       70 
## Parameters (fixed)            0 
## 
## Team                      Attack   Defense
## América (MG)              0.12    -0.20 
## Ath Paranaense             0.22     0.02 
## Atl Goianiense             0.00    -0.04 
## Atlético Mineiro          0.12     0.24 
## Avaí                     -0.10    -0.15 
## Bahia                      0.10     0.01 
## Botafogo (RJ)              0.22     0.31 
## Bragantino                 0.22    -0.03 
## Ceará                    -0.08     0.15 
## Chapecoense               -0.25    -0.20 
## Corinthians                0.07     0.16 
## Coritiba                   0.06    -0.25 
## Criciúma                 -0.28    -0.19 
## Cruzeiro                  -0.11     0.36 
## CSA                       -0.30    -0.11 
## Cuiabá                   -0.07     0.15 
## Figueirense               -0.24    -0.04 
## Flamengo                   0.42    -0.01 
## Fluminense                 0.26     0.12 
## Fortaleza                  0.08     0.18 
## Goiás                     0.02    -0.07 
## Grêmio                    0.31    -0.07 
## Internacional              0.09     0.17 
## Joinville                 -0.43    -0.07 
## Juventude                 -0.15    -0.18 
## Palmeiras                  0.39     0.26 
## Paraná                   -0.65    -0.03 
## Ponte Preta               -0.02    -0.07 
## Santa Cruz                 0.15    -0.40 
## Santos                     0.08    -0.07 
## São Paulo                 0.14     0.17 
## Sport Recife              -0.33     0.19 
## Vasco da Gama             -0.14    -0.07 
## Vitória                   0.08    -0.22 
## -------
## Intercept                 -0.12 
## Home field advantage       0.36 
## Dixon-Coles adj. (rho)    -0.01 
## Rue-Salvesen adj. (gamma) -0.43

Plotagem das variáveis de cada time do Campeonato Brasileiro de 2023

coef <- as.data.frame(model[["parameters"]][["attack"]])
coef$Def <- model[["parameters"]][["defense"]]
colnames(coef)[1] <- 'Att'
coef$Ovr <- coef$Att + coef$Def
coef <- coef[,c(3,1,2)]
coef$Time <- row.names(coef)
coef <- coef %>% filter(`Time` %in% times)

coefplot <- coef %>% ggplot(aes(x = Def, y = Att)) +
  geom_point(shape=21, stroke=0, fill="orange", color = "black", size=8) +
  #geom_text_repel(aes(label = team)) +
  #geom_text(aes(label = Time), position = position_nudge(y = -0.06)) +
  geom_text(aes(label = Time), hjust = -0.2, size = 5) +
  theme_minimal(base_size = 20) +
  labs(title = "Estimativa de parâmetros dos times",
       y = "Ataque",
       x = "Defesa")

print(coefplot)
ggsave(paste(folder,
             current_date,
             ' - Coeficientes.png',
             sep = ''),
       plot = coefplot)
## Saving 7 x 5 in image

Definindo a quantidade de simulações e executando

Cada iteração produz uma tabela de classificação final do campeonato, após todos clubes terem disputado suas 38 partidas, e uma lista dos 380 placares dos jogos entre as equipes. Todas essas tabelas e listas de jogos são agrupadas a um conjunto único, por motivos que serão explicados a seguir.

# Quantidade de simulações
runs = 10000

for(n in 1:runs){
  run <- test_data

  for(i in 1:nrow(run)){
    plac <- predict_goals(
      model,
      team1 = run$home[i],
      team2 = run$away[i],
      return_df = TRUE,
      maxgoal = 15)
    plac$res <- paste(plac$goals1,plac$goals2,sep="x")
    plac <- plac[c(1,2,5,6)]
    plac$probability <- ifelse(plac$probability < 0,
                               abs(plac$probability), plac$probability)
    
    match <- sample(plac$res, 1, prob = plac$probability)
    match <- data.frame(test_data$date[i], test_data$home[i],
                        test_data$away[i], match)
    colnames(match) <- c('date', 'home', 'away', 'x')
    match[c('hgoal', 'agoal')] <- str_split_fixed(match$x, 'x', 2)
    match$x <- 'x'
    match <- match[c(1,2,5,6,3)]
    run <- rbind(run,match)
  }
  
  run <- run %>% drop_na(hgoal)
  simmed <- run %>% select(1,2,3,4,5)
  total <- rbind(played_2023, simmed)
  
  classificacao_casa <- total %>%
    mutate(casa_V = calcV(hgoal, agoal),
           casa_E = calcE(hgoal, agoal),
           casa_D = calcD(hgoal, agoal),
           casa_PTS = calcPTS(hgoal,agoal)) %>%
    group_by(home) %>% summarise(casa_PTS = sum(casa_PTS),
                                 casa_J = length(home),
                                 casa_V = sum(casa_V),
                                 casa_E = sum(casa_E),
                                 casa_D = sum(casa_D),
                                 casa_GP = sum(as.numeric(hgoal)),
                                 casa_GS = sum(as.numeric(agoal)),
                                 casa_SG = sum(as.numeric(hgoal)) - sum(as.numeric(agoal))) %>%
    dplyr::rename(Time = home)
  
  classificacao_fora <- total %>%
    mutate(fora_V = calcV(agoal, hgoal),
           fora_E = calcE(agoal, hgoal),
           fora_D = calcD(agoal, hgoal),
           fora_PTS = calcPTS(agoal,hgoal)) %>%
    group_by(away) %>% summarise(fora_PTS = sum(fora_PTS),
                                 fora_J = length(away),
                                 fora_V = sum(fora_V),
                                 fora_E = sum(fora_E),
                                 fora_D = sum(fora_D),
                                 fora_GP = sum(as.numeric(agoal)),
                                 fora_GS = sum(as.numeric(hgoal)),
                                 fora_SG = sum(as.numeric(agoal)) - sum(as.numeric(hgoal))) %>%
    dplyr::rename(Time = away)
  
  classificacao_final <- inner_join(classificacao_casa, classificacao_fora, by = 'Time') %>%
    mutate(PTS = casa_PTS + fora_PTS,
           J = casa_J + fora_J,
           V = casa_V + fora_V,
           E = casa_E + fora_E,
           D = casa_D + fora_D,
           GP = casa_GP + fora_GP,
           GS = casa_GS + fora_GS,
           SG = casa_SG + fora_SG) %>%
    select(Time, PTS, J, V, E, D, GP, GS, SG) %>%
    arrange(desc(PTS), desc(V), desc(SG), desc(GP)) %>%
    mutate(Pos = row_number()) %>%
    relocate(Pos) %>%
    mutate(AP = round(PTS / (J * 3) * 100, digits = 1)) %>%
    mutate(sim = n)
  
  montecarlo_tabelas <- do.call(rbind, list(montecarlo_tabelas, classificacao_final))
  montecarlo_tabelas_df <- c(montecarlo_tabelas_df, list(classificacao_final))
  run <- run %>% mutate(sim = n)
  montecarlo_jogos <- do.call(rbind, list(montecarlo_jogos, run))
  montecarlo_jogos_df <- c(montecarlo_jogos_df, list(run))
}

Criando um dataframe médio pelas tabelas

Usando a lista de dataframes de tabelas de classificação anteriormente criado, será gerado um dataframe médio que permitirá aplicação de métodos de distância euclidiana. Após isso, cada tabela de classificação é comparada ao dataframe médio e uma distância euclidiana é calculada. Quanto maior essa distância, maior a diferença entre a iteração e o resultado médio.

Após todas as iterações serem avaliadas, é criado um dataframe distances_df listando o número de cada iteração e sua distância euclidiana com relação ao dataframe médio. Esse dataframe distances_df também possui uma coluna de probabilidade. Quanto mais próximo do dataframe médio, maior o valor da probabilidade. Essa coluna pode então ser usada em uma função sample com peso que nos permite sortear uma iteração X e conferir como ficou a tabela final de tal iteração.

# Calculate the average dataframe
if (!all(sapply(montecarlo_tabelas_df, function(df) identical(dim(df), dim(montecarlo_tabelas_df[[1]]))))) {
  stop("All dataframes must have the same dimensions.")
}
preprocess_dataframe <- function(df) {
  df_numeric <- as.data.frame(lapply(df, function(col) as.numeric(as.character(col))))
  return(df_numeric)
}
list_of_dataframes_numeric <- lapply(montecarlo_tabelas_df, preprocess_dataframe)
all_data <- array(unlist(list_of_dataframes_numeric), dim = c(nrow(list_of_dataframes_numeric[[1]]), ncol(list_of_dataframes_numeric[[1]]), length(list_of_dataframes_numeric)))
average_dataframe <- apply(all_data, c(1, 2), mean)
distances <- apply(all_data, 3, function(df) dist(rbind(df, average_dataframe))[1])
distances_vector <- unlist(distances)
distances_df <- data.frame(Index = seq_along(distances_vector), Distance = distances_vector)
distances_df <- distances_df %>%
  arrange(desc(Distance)) %>%
  mutate(prob = Distance / sum(Distance))
distances_df$prob <- distances_df$prob / sum(distances_df$prob)

head(select(distances_df, -2), n = 10)
##    Index         prob
## 1   8685 0.0003159649
## 2   7827 0.0002918119
## 3   6053 0.0002771370
## 4    173 0.0002761866
## 5   4588 0.0002736116
## 6   2495 0.0002634401
## 7   4055 0.0002610712
## 8   3055 0.0002602416
## 9   1735 0.0002584570
## 10  3224 0.0002564675

Montagem da tabela final do método Montecarlo

Diferentemente da etapa anterior, onde o foco era só analisar matematicamente quão próximos eram os dataframes entre si, o objetivo aqui é criar a tabela final de classificação do campeonato. Resumindo, os totais de pontos, gols, vitórias, empates e derrotas de cada clube são divididos pela quantidade de iteração e organizados seguindo os critérios de desempate da competição.

# Montar classificação média
classificacao_media <- montecarlo_tabelas %>% group_by(Time) %>%
  summarise(PTS = round(mean(PTS)),
            J = round(mean(J)),
            V = round(mean(V)),
            E = round(mean(E)),
            D = round(mean(D)),
            GP = round(mean(GP)),
            GS = round(mean(GS)),
            SG = round(mean(SG))) %>%
  arrange(desc(PTS), desc(V), desc(SG), desc(GP)) %>%
  mutate(Pos = row_number()) %>%
  relocate(Pos)

head(classificacao_media, n = 8)
## # A tibble: 8 × 10
##     Pos Time               PTS     J     V     E     D    GP    GS    SG
##   <int> <fct>            <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1     1 Botafogo (RJ)       80    38    24     8     6    60    26    34
## 2     2 Palmeiras           72    38    20    11     7    68    32    35
## 3     3 Flamengo            65    38    19     9    10    63    47    16
## 4     4 Fluminense          62    38    18     9    12    52    40    12
## 5     5 Grêmio              60    38    17     8    13    55    50     5
## 6     6 Ath Paranaense      57    38    16    10    12    52    45     7
## 7     7 Bragantino          56    38    15    13    11    50    44     6
## 8     8 Atlético Mineiro    55    38    15    11    12    44    35     9

Correção e padronização do nome de equipes

A seguir, utilizaremos outro site para obter os escudos de cada equipe. Alguns times estão nomeados diferentes nas duas fontes, então precisamos fazer algumas modificações nos dados.

classificacao_media$Time <- as.character(classificacao_media$Time)
classificacao_media[classificacao_media == 'Ath Paranaense'] <- 'Athletico'
classificacao_media[classificacao_media == 'Botafogo (RJ)'] <- 'Botafogo'
classificacao_media[classificacao_media == 'Bragantino'] <- 'RB Bragantino'

Probabilidades de término por clube e posição

Novamente usando a lista de dataframes anteriormente estabelecidas, criaremos uma visualização mostrando em porcentagem quantas vezes cada clube terminou em cada uma das 20 posições. Isso pode, portanto, ser considerado a probabilidade de cada clube terminar em cada posição. Ao menos de acordo com a capacidade de previsão do nosso modelo, com resultado a ser conferido ao término do campeonato de fato.

resumo <- montecarlo_tabelas %>%
  group_by(Pos, Time) %>%
  tally(name = "Total") %>%
  mutate(prob = Total / runs)

resumo$Time <- as.character(resumo$Time)
resumo[resumo == 'Ath Paranaense'] <- 'Athletico'
resumo[resumo == 'Botafogo (RJ)'] <- 'Botafogo'
resumo[resumo == 'Bragantino'] <- 'RB Bragantino'

resumoplot <- resumo %>%
  ggplot(aes(x = Pos,
             y = fct_reorder(Time,-Pos),
             fill = prob)) +
  geom_tile() +
  scale_x_continuous(breaks = seq(0, 24, 1),
                     expand = c(0.03, 0)) +
  scale_fill_continuous(low = "white", high = "#72aeb6") +
  geom_text(aes(label = paste0(prob * 100, "%"),
                size = 2,
                family = font)) +
  labs(title = 'Probabilidade por posição no Campeonato Brasileiro 2023',
       subtitle = gt::md(glue::glue("Simulado em {current_date}")),
       y = "",
       x = "Posição") +
  theme(plot.title = element_text(family = font, size = 30, face = "bold"),
        panel.grid.major = element_blank(),
        panel.background = element_blank(),
        legend.position = "none",
        axis.text.y = element_text(size = 14, family = font),
        axis.ticks = element_blank(),
        plot.subtitle = element_text(size = 16),
        axis.text.x = element_text(size = 12),
        axis.title.x = element_text(size = 16, family = font),
        plot.title.position = "plot",
        plot.caption = element_text(size = 12)) 

qtd_times <- classificacao_media %>% pull(Time) %>% n_distinct()
print(resumoplot)
ggsave(paste(folder, current_date, ' - Posições.png', sep = ''),
       plot = resumoplot, width = 18, height = 10)

Probabilidades de resultado por clube

resumo_zonas <- resumo %>%
  mutate(Zona = case_when(
    Pos >= 1 & Pos <= 6 ~ "Libertadores",
    Pos >= 7 & Pos <= 12 ~ "Sulamericana",
    Pos >= 17 & Pos <= 20 ~ "Rebaixamento",
    TRUE ~ "Outro")) %>%
  group_by(Zona, Time) %>%
  summarise(Count = sum(Total)) %>%
  mutate(prob = Count / runs * 100) %>%
  arrange(desc(Count))

resumo_lib <- resumo_zonas %>%
  subset(Zona == "Libertadores") %>%
  select(2, 4)

resumo_sula <- resumo_zonas %>%
  subset(Zona == "Sulamericana") %>%
  select(2, 4)

resumo_reb <- resumo_zonas %>%
  subset(Zona == "Rebaixamento") %>%
  select(2, 4)

Chances de Libertadores

resumo_lib_plot <- resumo_lib %>%
  arrange(desc(prob)) %>%
  ggplot(aes(x = Zona,
             y = fct_reorder(Time,prob),
             fill = prob)) +
  geom_tile() +
  scale_fill_continuous(low = "pink", high = "#72aeb6") +
  geom_text(aes(label = paste0(prob, "%"),
                size = 2,
                family = font)) +
  labs(title = 'Chances de Libertadores',
       y = "",
       x = "") +
  theme(plot.title = element_text(family = font, size = 30, face = "bold"),
        panel.grid.major = element_blank(),
        panel.background = element_blank(),
        legend.position = "none",
        axis.text.y = element_text(size = 14, family = font),
        axis.ticks = element_blank(),
        plot.subtitle = element_text(size = 16),
        axis.text.x = element_text(size = 12),
        axis.title.x = element_text(size = 16, family = font),
        plot.title.position = "plot",
        plot.caption = element_text(size = 12),
        plot.margin = margin(10, 1000, 1, 10, "pt"))

head(resumo_lib, n = 20)
## # A tibble: 17 × 3
## # Groups:   Zona [1]
##    Zona         Time               prob
##    <chr>        <chr>             <dbl>
##  1 Libertadores Botafogo         100   
##  2 Libertadores Palmeiras         99.4 
##  3 Libertadores Flamengo          89.6 
##  4 Libertadores Fluminense        73.2 
##  5 Libertadores Grêmio            60.6 
##  6 Libertadores Athletico         43.5 
##  7 Libertadores RB Bragantino     32.6 
##  8 Libertadores Atlético Mineiro  24.8 
##  9 Libertadores Fortaleza         23.7 
## 10 Libertadores São Paulo         23.4 
## 11 Libertadores Corinthians       10.6 
## 12 Libertadores Cuiabá             6.9 
## 13 Libertadores Internacional      5.95
## 14 Libertadores Cruzeiro           5.24
## 15 Libertadores Bahia              0.35
## 16 Libertadores Goiás              0.17
## 17 Libertadores Santos             0.12

Chances de Sulamericana

resumo_sula_plot <- resumo_sula %>%
  arrange(desc(prob)) %>%
  ggplot(aes(x = Zona,
             y = fct_reorder(Time,prob),
             fill = prob)) +
  geom_tile() +
  scale_fill_continuous(low = "pink", high = "#72aeb6") +
  geom_text(aes(label = paste0(prob, "%"),
                size = 2,
                family = font)) +
  labs(title = 'Chances de Sulamericana',
       y = "",
       x = "") +
  theme(plot.title = element_text(family = font, size = 30, face = "bold"),
        panel.grid.major = element_blank(),
        panel.background = element_blank(),
        legend.position = "none",
        axis.text.y = element_text(size = 14, family = font),
        axis.ticks = element_blank(),
        plot.subtitle = element_text(size = 16),
        axis.text.x = element_text(size = 12),
        axis.title.x = element_text(size = 16, family = font),
        plot.title.position = "plot",
        plot.caption = element_text(size = 12),
        plot.margin = margin(10, 1000, 1, 10, "pt"))

head(resumo_sula, n = 20)
## # A tibble: 19 × 3
## # Groups:   Zona [1]
##    Zona         Time              prob
##    <chr>        <chr>            <dbl>
##  1 Sulamericana Fortaleza        61.4 
##  2 Sulamericana Atlético Mineiro 60.4 
##  3 Sulamericana São Paulo        60.2 
##  4 Sulamericana RB Bragantino    57.7 
##  5 Sulamericana Corinthians      56.0 
##  6 Sulamericana Cuiabá           53.4 
##  7 Sulamericana Athletico        51.1 
##  8 Sulamericana Internacional    49.2 
##  9 Sulamericana Cruzeiro         46.5 
## 10 Sulamericana Grêmio           36.8 
## 11 Sulamericana Fluminense       25.6 
## 12 Sulamericana Bahia            14.3 
## 13 Sulamericana Flamengo         10.2 
## 14 Sulamericana Goiás             9.87
## 15 Sulamericana Santos            6.3 
## 16 Sulamericana Palmeiras         0.6 
## 17 Sulamericana Vasco da Gama     0.25
## 18 Sulamericana América (MG)      0.11
## 19 Sulamericana Coritiba          0.03

Chances de rebaixamento

resumo_reb_plot <- resumo_reb %>%
  arrange(desc(prob)) %>%
  ggplot(aes(x = Zona,
             y = fct_reorder(Time,prob),
             fill = prob)) +
  geom_tile() +
  scale_fill_continuous(low = "pink", high = "#72aeb6") +
  geom_text(aes(label = paste0(prob, "%"),
                size = 2,
                family = font)) +
  labs(title = 'Chances de Rebaixamento',
       y = "",
       x = "") +
  theme(plot.title = element_text(family = font, size = 30, face = "bold"),
        panel.grid.major = element_blank(),
        panel.background = element_blank(),
        legend.position = "none",
        axis.text.y = element_text(size = 14, family = font),
        axis.ticks = element_blank(),
        plot.subtitle = element_text(size = 16),
        axis.text.x = element_text(size = 12),
        axis.title.x = element_text(size = 16, family = font),
        plot.title.position = "plot",
        plot.caption = element_text(size = 12),
        plot.margin = margin(10, 1000, 1, 10, "pt"))

head(resumo_reb, n = 20)
## # A tibble: 16 × 3
## # Groups:   Zona [1]
##    Zona         Time              prob
##    <chr>        <chr>            <dbl>
##  1 Rebaixamento Coritiba         96.9 
##  2 Rebaixamento América (MG)     96.1 
##  3 Rebaixamento Vasco da Gama    92.0 
##  4 Rebaixamento Santos           44.5 
##  5 Rebaixamento Goiás            32.2 
##  6 Rebaixamento Bahia            25.5 
##  7 Rebaixamento Cruzeiro          3.57
##  8 Rebaixamento Internacional     3.28
##  9 Rebaixamento Cuiabá            2.15
## 10 Rebaixamento Corinthians       2.12
## 11 Rebaixamento Atlético Mineiro  0.47
## 12 Rebaixamento São Paulo         0.44
## 13 Rebaixamento Fortaleza         0.38
## 14 Rebaixamento RB Bragantino     0.21
## 15 Rebaixamento Grêmio            0.06
## 16 Rebaixamento Athletico         0.03

Início da criação da tabela visual final

# Função simples de extração do escudo de cada time
logo_image <- function(team_id, width = 20) {
  glue::glue("https://images.fotmob.com/image_resources/logo/teamlogo/{team_id}.png")
}

# Logotipo do Campeonato Brasileiro
league_logo <- "https://images.fotmob.com/image_resources/logo/leaguelogo/268.png"

# Criação de uma tabela auxiliar com o nome de cada time
# e um link para o respectivo escudo
team_ids <- fotmob_get_league_tables(league_id = 268) %>%
  filter(table_idx == 1:20) %>% slice(1:20)
team_ids <- team_ids %>%
  mutate(image_link = logo_image(team_id = unique(team_ids$table_id))) %>%
  select(4, 19)
colnames(team_ids)[1] <- 'Time'

# Novamente correção e padronização do nome de equipes
# Essencial para o full join
team_ids[team_ids == "America MG"] <- "América (MG)"
team_ids[team_ids == "Athletico Paranaense"] <- 'Athletico'
team_ids[team_ids == "Atletico MG"] <- 'Atlético Mineiro'
team_ids[team_ids == "Cuiaba"] <- 'Cuiabá'
team_ids[team_ids == "Goias"] <- 'Goiás'
team_ids[team_ids == "Gremio"] <- 'Grêmio'
team_ids[team_ids == "Red Bull Bragantino"] <- 'RB Bragantino'
team_ids[team_ids == "Santos FC"] <- 'Santos'
team_ids[team_ids == "Sao Paulo"] <- 'São Paulo'

classificacao_media <- full_join(classificacao_media, team_ids, by = 'Time') %>%
  relocate(image_link, .after = Pos)

Calculando tabela de acordo com os jogos disputados até a data de hoje

table_today <- calcTAB(played_2023)
table_today <- table_today[, -ncol(table_today)]
table_today$Time <- as.character(table_today$Time)
table_today[table_today == 'Ath Paranaense'] <- 'Athletico'
table_today[table_today == 'Botafogo (RJ)'] <- 'Botafogo'
table_today[table_today == 'Bragantino'] <- 'RB Bragantino'
table_today <- full_join(table_today, team_ids, by = 'Time') %>%
  relocate(image_link, .after = Pos)

head(select(table_today, -2), n = 8)
## # A tibble: 8 × 10
##     Pos Time            PTS     J     V     E     D    GP    GS    SG
##   <int> <chr>         <dbl> <int> <int> <int> <int> <dbl> <dbl> <dbl>
## 1     1 Botafogo         48    20    15     3     2    35    11    24
## 2     2 Palmeiras        37    20    10     7     3    36    17    19
## 3     3 Flamengo         35    20    10     5     5    34    26     8
## 4     4 Fluminense       34    20    10     4     6    28    20     8
## 5     5 Grêmio           33    19    10     3     6    29    25     4
## 6     6 Athletico        32    20     9     5     6    29    23     6
## 7     7 RB Bragantino    32    20     8     8     4    27    21     6
## 8     8 Fortaleza        29    20     8     5     7    22    19     3

Plotagem final da tabela de classificação simulada

(
  sim <-
    classificacao_media %>%
    gt::gt()  |>
    ##logos
    gtExtras::gt_img_rows(column = image_link, height = 20) |>
    ##change column names
    gt::cols_label(image_link = "")  %>%
    ##apply 538 theme
    gtExtras::gt_theme_538()  %>%
    ##highlight rows for top 4/5/and bottom 3
    gtExtras::gt_highlight_rows(
      columns = everything(),
      rows = 1:4,
      fill = '#ACE1AF',
      font_weight = "normal"
    )  |>
    gtExtras::gt_highlight_rows(
      columns = everything(),
      rows = 5:6,
      fill = '#D0F0C0',
      font_weight = "normal"
    )  |>
    gtExtras::gt_highlight_rows(
      columns = everything(),
      rows = 7:12,
      fill = '#FFDEAD',
      font_weight = "normal"
    )  |>
    gtExtras::gt_highlight_rows(
      columns = everything(),
      rows = 17:20,
      fill = '#FFCCCC',
      font_weight = "normal"
    )  |>
    ##align text
    gt::cols_align("center")  |>
    gt::cols_align(align = 'left',
                   columns = Time)  |>
    gt::cols_width(Time ~ px(165))  |>
    gt::cols_width(PTS ~ px(35))  |>
    gt::cols_width(J ~ px(35))  |>
    gt::cols_width(V ~ px(35))  |>
    gt::cols_width(E ~ px(35))  |>
    gt::cols_width(D ~ px(35))  |>
    gt::cols_width(GP ~ px(35))  |>
    gt::cols_width(GS ~ px(35))  |>
    gt::cols_width(SG ~ px(35))  |>
    gt::cols_width(SG ~ px(35))  |>
    gt::tab_style(style = cell_text(weight = 'bold'),
                  locations  = cells_body(columns = c(PTS, Pos)))  |>
    ##format title and subtitle (including league logo)
    gt::tab_header(
      title = gt::md(
        glue::glue(
          "<img src='{league_logo}' style='height:60px;'><br>Brasileirão 2023"
        )
      ),
      subtitle = gt::md(glue::glue("Simulado em **{current_date}**"))
    ))

Brasileirão 2023
Simulado em 25-08-2023
Pos Time PTS J V E D GP GS SG
1 Botafogo 80 38 24 8 6 60 26 34
2 Palmeiras 72 38 20 11 7 68 32 35
3 Flamengo 65 38 19 9 10 63 47 16
4 Fluminense 62 38 18 9 12 52 40 12
5 Grêmio 60 38 17 8 13 55 50 5
6 Athletico 57 38 16 10 12 52 45 7
7 RB Bragantino 56 38 15 13 11 50 44 6
8 Atlético Mineiro 55 38 15 11 12 44 35 9
9 Fortaleza 55 38 15 10 13 43 38 5
10 São Paulo 55 38 14 12 12 46 38 8
11 Corinthians 52 38 13 11 13 43 42 2
12 Cuiabá 50 38 14 9 15 38 43 -5
13 Internacional 50 38 13 11 14 38 43 -5
14 Cruzeiro 50 38 12 13 13 37 33 4
15 Bahia 44 38 11 11 16 42 48 -6
16 Goiás 42 38 11 10 17 37 54 -17
17 Santos 41 38 10 11 17 40 58 -18
18 Vasco da Gama 33 38 8 9 21 31 58 -27
19 América (MG) 31 38 7 9 22 41 74 -32
20 Coritiba 30 38 7 9 22 37 70 -33

Plotagem final da tabela de classificação atual

(
  act <-
    table_today %>%
    gt::gt()  |>
    ##logos
    gtExtras::gt_img_rows(column = image_link, height = 20) |>
    ##change column names
    gt::cols_label(image_link = "")  %>%
    ##apply 538 theme
    gtExtras::gt_theme_538()  %>%
    ##highlight rows for top 4/5/and bottom 3
    gtExtras::gt_highlight_rows(
      columns = everything(),
      rows = 1:4,
      fill = '#ACE1AF',
      font_weight = "normal"
    )  |>
    gtExtras::gt_highlight_rows(
      columns = everything(),
      rows = 5:6,
      fill = '#D0F0C0',
      font_weight = "normal"
    )  |>
    gtExtras::gt_highlight_rows(
      columns = everything(),
      rows = 7:12,
      fill = '#FFDEAD',
      font_weight = "normal"
    )  |>
    gtExtras::gt_highlight_rows(
      columns = everything(),
      rows = 17:20,
      fill = '#FFCCCC',
      font_weight = "normal"
    )  |>
    ##align text
    gt::cols_align("center")  |>
    gt::cols_align(align = 'left',
                   columns = Time)  |>
    gt::cols_width(Time ~ px(165))  |>
    gt::cols_width(PTS ~ px(35))  |>
    gt::cols_width(J ~ px(35))  |>
    gt::cols_width(V ~ px(35))  |>
    gt::cols_width(E ~ px(35))  |>
    gt::cols_width(D ~ px(35))  |>
    gt::cols_width(GP ~ px(35))  |>
    gt::cols_width(GS ~ px(35))  |>
    gt::cols_width(SG ~ px(35))  |>
    gt::cols_width(SG ~ px(35))  |>
    gt::tab_style(style = cell_text(weight = 'bold'),
                  locations  = cells_body(columns = c(PTS, Pos)))  |>
    ##format title and subtitle (including league logo)
    gt::tab_header(
      title = gt::md(
        glue::glue(
          "<img src='{league_logo}' style='height:60px;'><br>Brasileirão 2023"
        )
      ),
      subtitle = gt::md(glue::glue("Classificação em **{current_date}**"))
    ))

Brasileirão 2023
Classificação em 25-08-2023
Pos Time PTS J V E D GP GS SG
1 Botafogo 48 20 15 3 2 35 11 24
2 Palmeiras 37 20 10 7 3 36 17 19
3 Flamengo 35 20 10 5 5 34 26 8
4 Fluminense 34 20 10 4 6 28 20 8
5 Grêmio 33 19 10 3 6 29 25 4
6 Athletico 32 20 9 5 6 29 23 6
7 RB Bragantino 32 20 8 8 4 27 21 6
8 Fortaleza 29 20 8 5 7 22 19 3
9 Cuiabá 28 20 8 4 8 21 23 -2
10 São Paulo 28 20 7 7 6 24 19 5
11 Atlético Mineiro 27 20 7 6 7 22 18 4
12 Cruzeiro 25 20 6 7 7 20 17 3
13 Corinthians 24 19 6 6 7 21 22 -1
14 Internacional 24 20 6 6 8 17 24 -7
15 Goiás 23 20 6 5 9 19 28 -9
16 Bahia 21 20 5 6 9 22 25 -3
17 Santos 21 20 5 6 9 21 32 -11
18 Vasco da Gama 16 19 4 4 11 15 29 -14
19 Coritiba 14 20 3 5 12 20 39 -19
20 América (MG) 10 19 2 4 13 20 44 -24
gt::gtsave(act, paste(folder, current_date, ' - Tabela HOJE.png', sep = ''), expand = 60)
gt::gtsave(sim, paste(folder, current_date, ' - Tabela FINAL.png', sep = ''), expand = 60)